The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Changes 012
MANIFEST 01
META.yml 11
eg/dot-psgi/nonblock-hello.psgi 020
lib/Plack/Handler/Apache1.pm 11
lib/Plack/Handler/CGI.pm 1235
lib/Plack/Middleware/AccessLog.pm 11
lib/Plack/Middleware/Lint.pm 09
lib/Plack/Request.pm 11
lib/Plack/Response.pm 18
lib/Plack/Server/ServerSimple.pm 11
lib/Plack/Util.pm 11
lib/Plack.pm 11
t/Plack-Loader/auto.t 02
t/Plack-Middleware/conditionalget_writer.t 1511
t/Plack-Middleware/lint.t 015
16 files changed (This is a version diff) 35120
@@ -2,6 +2,18 @@ Revision history for Perl extension Plack
 
 Take a look at http://github.com/miyagawa/Plack/issues for the planned changes before 1.0 release.
 
+0.9979  Tue May 17 09:54:03 PDT 2011
+    [BUG FIXES]
+        - Fixed Middleware::AccessLog's default %t format to match Apache's format
+        - Fixed a warning in Apache1 handler where PATH_INFO doesn't exist #204
+        - Fixed a bad test relying on new Test::More versions
+
+    [IMPROVEMENTS]
+        - Fixed Lint to accept bare in-memory filehandle per http://stackoverflow.com/questions/6011793/
+        - Added setup_env() to Plack::Handler::CGI (markstos)
+        - Added a non-blocking Hello World example in eg/dot-psgi
+        - Doc cleanup
+
 0.9978  Wed May  4 11:29:12 PDT 2011
     [TEST FIXES]
         - Fixed a failing output_encoding.t because of FCGI dependencies
@@ -20,6 +20,7 @@ eg/dot-psgi/frameworks/Schenker.psgi
 eg/dot-psgi/frameworks/Squatting.psgi
 eg/dot-psgi/Hello.psgi
 eg/dot-psgi/image.psgi
+eg/dot-psgi/nonblock-hello.psgi
 eg/dot-psgi/plack-req.psgi
 eg/dot-psgi/runnable.psgi
 eg/dot-psgi/slowapp.psgi
@@ -40,4 +40,4 @@ resources:
   homepage: http://plackperl.org
   license: http://dev.perl.org/licenses/
   repository: git://github.com/miyagawa/Plack.git
-version: 0.9978
+version: 0.9979
@@ -0,0 +1,20 @@
+use AnyEvent;
+
+my $app = sub {
+    my $env = shift;
+
+    warn "This app needs a server that supports psgi.streaming and psgi.nonblocking"
+        unless $env->{'psgi.streaming'} && $env->{'psgi.nonblocking'};
+
+    my $cv = AE::cv;
+    return sub {
+        my $respond = shift;
+        my $w = $respond->([ 200, ['Content-Type' => 'text/plain'] ]);
+        $w->write("Hello\n");
+        my $t; $t = AE::timer 2, 0, sub {
+            undef $t;
+            $w->write("World\n");
+            $w->close;
+        };
+    };
+};
@@ -54,7 +54,7 @@ sub call_app {
         $env->{HTTP_AUTHORIZATION} = $HTTP_AUTHORIZATION;
     }
 
-    my $vpath    = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
+    my $vpath    = $env->{SCRIPT_NAME} . ($env->{PATH_INFO} || '');
 
     my $location = $r->location || "/";
        $location =~ s{/$}{};
@@ -64,6 +64,27 @@ sub new { bless {}, shift }
 sub run {
     my ($self, $app) = @_;
 
+    my $env = $self->setup_env();
+
+    my $res = $app->($env);
+    if (ref $res eq 'ARRAY') {
+        $self->_handle_response($res);
+    }
+    elsif (ref $res eq 'CODE') {
+        $res->(sub {
+            $self->_handle_response($_[0]);
+        });
+    }
+    else {
+        die "Bad response $res";
+    }
+}
+
+sub setup_env {
+    my ( $self, $override_env ) = @_;
+
+    $override_env ||= {};
+
     my $env = {
         %ENV,
         'psgi.version'    => [ 1, 1 ],
@@ -75,6 +96,7 @@ sub run {
         'psgi.run_once'     => 1,
         'psgi.streaming'    => 1,
         'psgi.nonblocking'  => 1,
+        %{ $override_env },
     };
 
     delete $env->{HTTP_CONTENT_TYPE};
@@ -90,20 +112,11 @@ sub run {
         $env->{PATH_INFO}   = '/' . $env->{PATH_INFO};
     }
 
-    my $res = $app->($env);
-    if (ref $res eq 'ARRAY') {
-        $self->_handle_response($res);
-    }
-    elsif (ref $res eq 'CODE') {
-        $res->(sub {
-            $self->_handle_response($_[0]);
-        });
-    }
-    else {
-        die "Bad response $res";
-    }
+    return $env;
 }
 
+
+
 sub _handle_response {
     my ($self, $res) = @_;
 
@@ -185,6 +198,16 @@ CGI-compatible perl-based web server:
 
 This is a handler module to run any PSGI application as a CGI script.
 
+=head1 UTILITY METHODS
+
+=head2 setup_env()
+
+  my $env = Plack::Handler::CGI->setup_env();
+  my $env = Plack::Handler::CGI->setup_env(\%override_env);
+
+Sets up the PSGI environment hash for a CGI request from C<< %ENV >>> and returns it.
+You can can provide a hashref of key/value pairs to override the defaults if you would like.
+
 =head1 SEE ALSO
 
 L<Plack>
@@ -64,7 +64,7 @@ sub log_line {
         h => sub { $env->{REMOTE_ADDR} || '-' },
         l => sub { '-' },
         u => sub { $env->{REMOTE_USER} || '-' },
-        t => sub { "[" . $strftime->("%d/%b/%Y %H:%M:%S", localtime) . "]" },
+        t => sub { "[" . $strftime->("%d/%b/%Y:%H:%M:%S %z", localtime) . "]" },
         r => sub { _safe($env->{REQUEST_METHOD}) . " " . _safe($env->{REQUEST_URI}) .
                    " " . $env->{SERVER_PROTOCOL} },
         s => sub { $status },
@@ -83,6 +83,14 @@ sub validate_env {
     }
 }
 
+sub is_possibly_fh {
+    my $fh = shift;
+
+    ref $fh eq 'GLOB' &&
+    *{$fh}{IO} &&
+    *{$fh}{IO}->can('getline');
+}
+
 sub validate_res {
     my ($self, $res, $streaming) = @_;
 
@@ -112,6 +120,7 @@ sub validate_res {
     unless (@$res == 2 ||
             ref $res->[2] eq 'ARRAY' ||
             Plack::Util::is_real_fh($res->[2]) ||
+            is_possibly_fh($res->[2]) ||
             (blessed($res->[2]) && $res->[2]->can('getline'))) {
         $croak->('body should be an array ref or filehandle');
     }
@@ -2,7 +2,7 @@ package Plack::Request;
 use strict;
 use warnings;
 use 5.008_001;
-our $VERSION = '0.9978';
+our $VERSION = '0.9979';
 $VERSION = eval $VERSION;
 
 use HTTP::Headers;
@@ -1,7 +1,7 @@
 package Plack::Response;
 use strict;
 use warnings;
-our $VERSION = '0.9978';
+our $VERSION = '0.9979';
 $VERSION = eval $VERSION;
 
 use Plack::Util::Accessor qw(body status);
@@ -271,6 +271,13 @@ B<does not> convert string formats such as C<+3M>.
       expires => time + 24 * 60 * 60,
   };
 
+=item finalize
+
+  $res->finalize;
+
+Returns the status code, headers, and body of this response as a PSGI
+response array reference.
+
 =back
 
 =head1 AUTHOR
@@ -1,6 +1,6 @@
 package Plack::Server::ServerSimple;
 use strict;
-our $VERSION = '0.9978';
+our $VERSION = '0.9979';
 $VERSION = eval $VERSION;
 
 use parent qw(Plack::Handler::HTTP::Server::Simple);
@@ -259,7 +259,7 @@ sub encode_html {
 
 sub inline_object {
     my %args = @_;
-    bless {%args}, 'Plack::Util::Prototype';
+    bless \%args, 'Plack::Util::Prototype';
 }
 
 sub response_cb {
@@ -3,7 +3,7 @@ package Plack;
 use strict;
 use warnings;
 use 5.008_001;
-our $VERSION = '0.9978';
+our $VERSION = '0.9979';
 $VERSION = eval $VERSION;
 
 1;
@@ -1,4 +1,5 @@
 use strict;
+use warnings;
 use Test::More;
 use Plack::Loader;
 
@@ -12,6 +13,7 @@ my $builder = sub {
 $INC{"Plack/Handler/Twiggy.pm"} = __FILE__;
 sub Plack::Handler::Twiggy::new { bless {}, shift }
 
+no warnings 'redefine';
 local *Plack::Loader::env = sub { return {} };
 
 eval {
@@ -25,21 +25,17 @@ my $handler = builder {
 test_psgi $handler, sub {
     my $cb = shift;
 
-    subtest 'streaming' => sub {
-        my $res = $cb->( GET "http://localhost/streaming-klingklangklong" );
-        is $res->code, 200, 'Response HTTP status';
-        is $res->content, 'klingklangklong', 'Response content';
-    };
-
-    subtest 'streaming not modified' => sub {
-        # the middleware does not support streaming interface but make it at least not die
-        my $res = $cb->( GET
-            "http://localhost/streaming-klingklangklong",
-            'If-None-Match' => 'DEADBEEF'
-        );
-        is $res->code, 200, 'Response HTTP status';
-        is $res->content, 'klingklangklong', 'Response content';
-    };
+    my $res = $cb->( GET "http://localhost/streaming-klingklangklong" );
+    is $res->code, 200, 'Response HTTP status';
+    is $res->content, 'klingklangklong', 'Response content';
+
+    # the middleware does not support streaming interface but make it at least not die
+    $res = $cb->( GET
+        "http://localhost/streaming-klingklangklong",
+        'If-None-Match' => 'DEADBEEF'
+    );
+    is $res->code, 200, 'Response HTTP status';
+    is $res->content, 'klingklangklong', 'Response content';
 };
 
 done_testing;
@@ -17,6 +17,13 @@ my @bad = map { Plack::Middleware::Lint->wrap($_) } (
     sub { return sub { shift->([ 200, [], undef ]) } },
 );
 
+my @good = map { Plack::Middleware::Lint->wrap($_) } (
+    sub {
+        open my $io, "<", \"foo";
+        return [ 200, [ "Content-Type", "text/plain" ], $io ];
+    },
+);
+
 for my $app (@bad) {
     test_psgi $app, sub {
         my $cb = shift;
@@ -25,4 +32,12 @@ for my $app (@bad) {
     };
 }
 
+for my $app (@good) {
+    test_psgi $app, sub {
+        my $cb = shift;
+        my $res = $cb->(GET "/");
+        is $res->code, 200, $res->content;
+    };
+}
+
 done_testing;